# ======================================================================
#
# Copyright (C) ADN
# ADN::XML::OBJtoXML OBJtoXML.pm
# Description:
#  - Concevoir un XML depuis Objet
#
# ======================================================================

package ADN::XML::OBJtoXML;

use vars qw($AUTOLOAD);
use strict;

# #######################
# Création de l'objet self + init. variables
# #######################
sub new
{
	my $self = shift;
	my $class = ref($self) || $self;
	return $self if ref $self;
	$self = bless {} => $class;
	$self->{nbr_saut} = 0;
	return $self;
}

# #######################
# Fonction detect si c'est un tableau
# #######################

sub is_array_objtoxml
{
    my $self = shift;
    ($self->{is_array}) = $self->{value};
    return 0 unless ref $self->{is_array};

    eval { my $a = @{$self->{is_array}}; };
    if ($@ =~ /^Not an ARRAY reference/smx)
    {
      undef $a;
      return 0;
    }
    else
    {
      undef $a;
      return 1;
    }
}

# #######################
# Fonction detect si c'est un objet
# #######################

sub is_objet_objtoxml
{
    my $self = shift;
    ($self->{is_objet}) = $self->{value};
    $self->{match_is_objet} = $self;
    $self->{match_is_objet} =~ s/^(.*)=HASH\(0x[0-9a-fA-F]+\)$/$1/smx;
    if (defined $self->{match_is_objet} && defined $self->{is_objet} )
    {
      if ($self->{is_objet} =~ /^$self->{match_is_objet}=HASH\(0x[0-9a-fA-F]+\)$/smx)
      {
         return 1;
      }
      else
      {
         return 0;
      }
    }
}

# #######################
# Fonction nettoyage tableau
# #######################

sub clear_tablo_objtoxml
{
	my $self = shift;
	my $i = 0;
	my $t = 0;

  while (defined @{$self->{result}}[$i])
  {
     if ($i >= ($self->{nbr_saut}))
     {
         ${$self->{result}}[$i] = "";
         $t++;
     }
     $i++;
  }
  undef $i;
  undef $t;
	return @{$self->{result}};
}

# #######################
# Fonction mise en forme xml
# pour tableau
# #######################

sub concatenation_objtoxml
{
    my $self = shift;
    my $result;
    my $i = 0;

    foreach my $l (@{$self->{value}})
    {
        if($i >= ($self->{nbr_saut}))
        {
            $result .= $l;
        }
		$i++;
    }
	$self->clear_tablo_objtoxml();
  $result =~ s/\s*$//smx;
  ${$self->{result}}[$self->{nbr_saut}] = '<'.$self->{nom_balise}.'>'.$result.'</'.$self->{nom_balise}.'>';
	$self->{nbr_saut}++;
  undef $i;
  undef $result;
  return @{$self->{result}};
}

# #######################
# Fonction pour les divers options
# #######################

sub option_objtoxml
{
	my $self = shift;

	if (defined $self->{value2})
	{
  	if ($self->{value2} =~ m/^all$/ismx)
	  {
		  $self->{nbr_saut} = 0;
	  }
	 if ($self->{value2} =~ m/^sauv$/ismx)
	 {
		  $self->{nbr_saut}++;
	 }
	}
	return;
}

# #######################
# Fonction Mise en xml
# #######################

sub xml_objtoxml
{
	my $self = shift;
  my $i = 0;

	if (defined $self->{value})
  {
    $self->{value} = '<'.$self->{nom_balise}.'>'.$self->{value}.'</'.$self->{nom_balise}.'>';
  }
  else
  {
    $self->{value} = '<'.$self->{nom_balise}.'></'.$self->{nom_balise}.'>';
  }
  while (1)
  {
      if (!(defined @{$self->{result}}[$i]))
      {
          @{$self->{result}}[$i] = $self->{value};
          last;
      }
      $i++;
  }
  undef $i;
	return @{$self->{result}};
}

# #######################
# Fonction DESTROY
# #######################

sub DESTROY
{
  my $self = shift;
  undef $self;
  return;
}

# #######################
# Fonction AUTOLOAD
# #######################

sub AUTOLOAD
{
  my $self = shift;
  ($self->{value}, $self->{value2}) = (shift, shift);
  $self->{nom_balise} = $AUTOLOAD;
  $self->{nom_balise} =~ s/.*:://smx;

  if ($self->is_objet_objtoxml())
  {
       my @tab_objet = @{${$self}{result}};
       $self->{value} = \@tab_objet;
       $self->concatenation_objtoxml();
  }
  elsif ($self->is_array_objtoxml())
  {
       $self->concatenation_objtoxml();
  }
  else
  {
		@{$self->{result}} = $self->xml_objtoxml();
  }
	$self->option_objtoxml();
  return @{$self->{result}};
}
1;
__END__